perm filename IBM360[M5,LCS] blob
sn#107296 filedate 1975-07-16 generic text, type T, neo UTF8
C*SCOR5-- FOR IBM360 (OLDER VERSION C.1970) NEEDS LOCAL RANDOM GEN.
BLOCK DATA
COMMON /X/ P(30),J,L,CNT(10),BT,MK,VX(35),PL(30),DF,IXIN,NINS,TF,
1 ROFF(10),V(2000),NP(10),PCH(10,32),INST(11),DUR(11),IALL,
1DURX,AMPFAC,BNW(40),IT(30),I,OP1,INUM(10),BG(80),INP(72),TP,
1NWZ,CVTX,ISCA(12),IDAT(11),IQ(25),SCAL(86),MU5(14)
1,LIST(78),ALL(10,31)
C INST AND DUR MUST HAVE 1 MORE THAN MAX NUM OF INSTS IN ARRAYS!!!
DATA ISCA/'C','P','D','N','E','F','U','G','S','A','V','B'/
DATA IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
DATA MU5/'T','C','2','N','V','R','3','4','X','I','H','M','D','S'/
C OUT, OSC, AD2, RAN, ENV, STR, AD3, AD4, MLT, SET, RAH.(CONT AND FLT NOT USED.
DATA V/2000*0/,BT/0/,PL/30*0/,I/1/,NINS/0/,IXIN/1/,TP/0/,NWZ/1/,
1CNT/10*0/,NP/10*0/,PCH/320*0/,CVTX/10000./,DURX/19999./,PL/30*1./
1,AMPFAC/1./,TF/1./,IALL/0/,ALL/310*-1/
DATA SCAL/'C1','CS1','D1','DS1','E1','F1','FS1','G1',
1 'GS1','A1','AS1','B1','C2','CS2','D2','DS2','E2',
1 'F2','FS2','G2','GS2','A2','AS2','B2','C3','CS3','D3','DS3',
1 'E3','F3','FS3','G3','GS3','A3', 'AS3','B3','C4','CS4',
1 'D4','DS4','E4','F4','FS4','G4','GS4','A4','AS4','B4','C5','CS5'
1 ,'D5','DS5','E5','F5','FS5','G5','GS5','A5','AS5','B5','C6','CS6'
1 ,'D6','DS6','E6','F6','FS6','G6','GS6','A6','AS6','B6','C7','CS7'
1 ,'D7','DS7','E7','F7','FS7','G7','GS7','A7','AS7','B7','R','END'/
END
C IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C SUBROUTINE SUBR
C COMMON /X/ P(30),INST,IPAR,CNT(10),BT,IREST,CVT(35),PL(30),DF
C INST=INST N. IPAR=PARAM N. DF=DUTY FACTOR. WHEN SUBROUTINE IS CALLED
COMMON /X/ P(30),J,L,CNT(10),BT,MK,VX(35),PL(30),DF,IXIN,NINS,TF,
1 ROFF(10),V(2000),NP(10),PCH(10,32),INST(11),DUR(11),IALL,
1DURX,AMPFAC,BNW(40),IT(30),I,OP1,INUM(10),BG(80),INP(72),TP,
1NWZ,CVTX,ISCA(12),IDAT(11),IQ(25),SCAL(86),MU5(14)
1,LIST(78),ALL(10,31)
DATA ICOM/','/,IMIN/'-'/,ISEMI/';'/,DEBUG/0/,PARENS/0/,LN/0/,
1IBLA/' '/,KSLA/'/'/,IEND2/'END;'/,IEND/'END'/,JZ/0/,KL/0/,RA/0/,
1BY/-1./,LPAR/0/,ITMPO/'TEMP'/,IRUN2/'RUN;'/,IRUN/'RUN'/,KZY/10/
1,IDALL/0/,ISTAR/'*'/,ILFP/'('/,IAT/'@'/,IPLUS/'+'/,LCNT/1/
1,RETRO/-1./,INVRT/-1/,IRTP/')'/,IEL/'L'/,IDOL/'$'/
EQUIVALENCE (V2,V(2)),(V3,V(3)),(V4,V(4)),(VX2,VX(2)),(VX1,VX(1))
1,(IPP,ISCA(2)),(VX3,VX(3)),(V5,V(5)),(IEN,ISCA(4)),(IE,ISCA(5))
1,(VX4,VX(4)),(VX5,VX(5)),(VX6,VX(6)),(IU,ISCA(7)),(ITT,MU5(1))
1,(ISS,ISCA(9)),(IV,ISCA(11)),(ID,ISCA(3)),(IF,ISCA(6)),(IDOT,
1IDAT(11)),(IEM,MU5(12)),(II,MU5(10)),(IR,MU5(6)),(IXX,MU5(9))
1,(IG,ISCA(8)),(IAA,ISCA(10))
C IF DIMENSIONS ARE CHANGED, CHANGE KZY. ALL CHANGES MUST BE MULTIPLES OF KZY.
C SET INST(KZY+1), CHECK BG, CHECK BLOCK DATA VALUES.
DO 1900 K=1,10
1900 INUM(K)=K
C SET NDEC TO 5 FOR IBM.
3000 FORMAT(1X72A1)
JMP=1
8002 JA=-1
ICT=0
IF(JZ.EQ.-1)GO TO 1773
8001 READ(5,5900)INP
C REMOVE KW ETC. FOR IBM.
7006 PRINT 3000,INP
IF(INP(1).EQ.IBLA)GO TO 8001
C BLANK LINES MAY APPEAR IN INSTS.
MLX=1
GO TO 1773
101 ISUB=5
IZ=15
N=INP(ML+2)
DO 2900 K=1,14
2900 IF(N.EQ.MU5(K))IZ=K
IF(IZ.NE.1)GO TO 3900
IF(INP(ML).EQ.IEM)IZ=9
IF(INP(ML).EQ.ISS)IZ=10
IF(INP(ML+1).EQ.IR)IZ=12
GO TO 4900
3900 IF(INP(ML).NE.IG)GO TO 4900
ISUB=6
GO TO 2899
4900 IF(IZ.LE.11)GO TO 9015
IZ=IZ-11
GO TO (9018,9014,6900,1129),IZ
C SRT END INS SCORE
C ABOVE FOR UNIT GENERATORS
6900 Y=36.
ISUB=12
GO TO 2899
12 V2=2.
V3=VX1
V4=VX2
L=4
GO TO 72
5 L=JJ+4
DO 9021 K=5,L
9021 V(K)=VX(K-4)
GO TO(72,172,72,172,172,72,72,72,72,72,172,72,72),IZ
172 NL=1
IF(IZ.EQ.4)NL=3
IF(IZ.EQ.11)NL=2
DO 472 K=1,NL
Y=Y-1.
L=L+1
472 V(L)=Y
IF(IZ.EQ.2)L=9
C ABOVE ALLOWS A 'V' TO BE PUT AT END OF OSC.
72 M=L-1
WRITE(8)M,(V(K),K=2,L)
C WRITE(6,5552)M,(V(K),K=2,L)
6006 PRINT 5552,M,(V(K),K=2,L)
IF(LPAR)2129,8002,8002
5552 FORMAT(I3,(14F9.2))
9014 L=3
GO TO 72
6 L=JJ+ICT+2
V2=3.
NL=3
IF(JA.NE.-9998)GO TO 8006
NL=ICT+1
L=L-2
8006 DO 9022 K=NL,L
9022 V(K)=VX(K-NL+1)
IF(IAMP.LT.0)GO TO 72
READ(5,5900)INP
PRINT 3000,INP
IAMP=0
DO 90221 K=1,72
N=INP(K)
IF(N.NE.ISTAR)GO TO 90221
IAMP=-1
GO TO 90222
90221 IF(N.EQ.ISEMI)GO TO 90222
90222 ML=1
JA=-9998
ICT=ICT+L
GO TO 1899
9015 JA=0
C L+100=MACH.LANG. UNIT GENS. L=FORTR. UNIT GENS.
V4=IZ+100
IF(IZ.EQ.6)LPAR=1
GO TO 2899
9018 ISUB=8
V4=4.
GO TO 2899
8 V5=VX1
V2=11.
L=5
CVTX=V5
GO TO 72
1129 IF(LPAR)2129,2129,222
222 L=5
V2=12.
V4=8.
V5=1.
LPAR=-1
GO TO 72
2129 ISUB=7
LPAR=0
DO 107 K=1,6
107 VX(K)=0
ML=ML+5
GO TO 1899
5900 FORMAT(72A1)
1107 FORMAT(A4,72A1)
3001 FORMAT(1XA4,72A1)
7 IF(VX1.NE.0)IXIN=VX1
IF(VX2.NE.0)TF=VX2
IF(VX3.NE.0)AMPFAC=VX3
OP1=VX4
IF(VX5.NE.0)DURX=VX5
DEBUG=VX6
C TYPE 'SCORE', RAN NUM, TF=TEMPO FACTOR(0=1), AMPFAC=AMPL.FACT(0=1)
C OP1=SECONDS TO BE OMITTED,
C DURX=DUR AT CUTOFF, DEBUG>0 PRINTS 'V' ARRAY.
C *************** READS INPUT ***********************
2308 READ(5,1107)J,INP
IF(J.EQ.IBLA)GO TO 2308
PRINT 3001,J,INP
MLX=1
JA=-1
ISUB=9
JMP=5
VX1=0
VX2=0
VX3=0
LK=-1
K=0
IF(V(I-1).NE.-9900.-BY)GO TO 6773
BY=-1.
I=I-1
6773 K=K+1
IF(K.GT.NINS)GO TO 36
IF(INST(K).NE.J)GO TO 6773
LK=K
GO TO 1773
36 IF(J.EQ.IRUN.OR.J.EQ.IRUN2)GO TO 4337
IF(J.EQ.ITMPO)GO TO 1773
LK=NINS+1
IF(LK.GT.KZY)CALL EXIT
INST(LK)=J
IZ=LK
GO TO 1773
4337 IF(V(I-1).EQ.-9900.-BY)I=I-1
V(I)=-19899.
IF(DEBUG.NE.0)CALL RUNIT
N=1
5002 K=N+1
IF(N.GT.I)CALL RUNIT
IF(V(N).GE.0)GO TO 1002
PRINT 4002,V(N)
N=N+1
GO TO 5002
1002 J=V(K)+K-1
IF(J.LT.N)J=N
PRINT 4002,(V(K),K=N,J)
N=J+1
GO TO 5002
4002 FORMAT(10F12.3)
9 IF(LK.LE.NINS)GO TO 8773
IF(IALL.EQ.0)GO TO 1004
IF(IDALL.GT.0)GO TO 8773
BG(LK)=VX1
IDALL=LK
GO TO 2004
1004 BG(LK)=VX1
C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0. CHECK EFFECT ON 'MOVE'!
C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
IF(LK.EQ.IZ)VX1=0
2004 NINS=LK
IF(VX3.NE.0)VX2=10000.+VX3
IF(VX2.EQ.0)VX2=-1
DUR(LK)=VX2
GO TO 900
8773 IF(VX2.NE.0)VX1=VX1*10000.+VX2
900 IF(VX1.EQ.BY)GO TO 5773
BY=VX1
K=V(I-1)/(-9900.)
IF(K.GE.1.AND.K.LE.NINS)I=I-1
V(I)=-9900.-BY
I=I+1
IF(NWZ.EQ.0)GO TO 4308
DO 9703 K=1,NWZ
9703 IF(BY.EQ.BNW(K))GO TO 5773
4308 NWZ=NWZ+1
BNW(NWZ)=BY
5773 IF(J.EQ.ITMPO)GO TO 1106
4773 NW=LPAR
JMP=2
1299 IF(JZ.NE.0)GO TO 1773
7773 READ(5,5900)INP
IF(INP(1).EQ.IBLA)GO TO 7773
PRINT 3000,INP
MLX=1
C 'LISTS' END WITH *
1773 JZ=0
IALL=0
17731 ML=MLX
DO 236 JD=ML,72
JF=INP(JD)
C """""""""" MAY 13,71 /Z(D4/E/X 2 3/)CS/ ETC. CAN USE 26 LABELS.
33611 IF(JF.NE.ILFP.AND.JF.NE.IRTP)GO TO 2361
INP(JD)=IBLA
L=JD-1
1113 IF(INP(L).NE.IBLA)GO TO 2113
L=L-1
GO TO 1113
2113 IF(JF.EQ.IRTP)GO TO 3361
IF(PARENS.EQ.0)GO TO 1140
LCNT=LCNT+3
MOT=LCNT-1
1140 LIST(LCNT)=INP(L)
PARENS=-1.
INP(L)=IBLA
C ALLOWS FOR SPACE AFTER IDENTIFIER
LIST(LCNT+1)=I
GO TO 236
3361 IF(PARENS.EQ.0)GO TO 2140
LIST(LCNT+2)=I-1+IAMP
C +IAMP IS TO ADD SPACE FOR CVT IN V ARRAY.
LCNT=LCNT+3
PARENS=0
GO TO 236
2140 LIST(MOT)=I-1+IAMP
GO TO 236
C """"""""""" LAST ) CAN'T APPEAR AT END OF LINE!!
C @@@@@@@@@@@@ /@Z/DS3/ ETC.
2361 IF(JF.NE.IAT)GO TO 5361
DO 113 L=1,72
K=JD+L
JG=INP(K)
IF(JG.NE.IMIN)GO TO 6113
RETRO=0
GO TO 113
6113 IF(JG.NE.IDOL)GO TO 7113
C IDOL IS FOR INVERSIONS IN 'NOTES'
INVRT=0
GO TO 113
7113 IF(JG.NE.IBLA)GO TO 4113
113 CONTINUE
4113 DO 6361 L=1,LCNT,3
IF(JG.NE.LIST(L))GO TO 6361
VX1=0
DO 40 M=JD+2,72
JG=INP(M)
IF(JG.EQ.IBLA)GO TO 40
ML=M
IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.ISTAR)GO TO 140
GO TO 240
40 CONTINUE
240 JC=JA
JA=-1
ICT=ISUB
ISUB=15
INP(K)=IBLA
GO TO 1899
15 ISUB=ICT
JA=JC
140 JC=1
KN=LIST(L+1)
M=LIST(L+2)+1
IF(RETRO)GO TO 640
JC=M-1
M=KN-1
KN=JC
JC=-1
RETRO=-1.
640 IF(INVRT)GO TO 940
840 X=V(KN)
V(I)=X+VX1
C FINDS CENTER FOR INVERSION (+TRANSP.)
I=I+1
KN=KN+JC
IF(V(KN-JC).NE.85.)GO TO 940
V(I-1)=85.
GO TO 840
940 Z=V(KN)
IF(INVRT.EQ.0)GO TO 440
IF(VX1.EQ.0)GO TO 540
C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
IF(CODE.EQ.-33.)GO TO 440
V(I)=Z*VX1
GO TO 7361
440 IF(Z.EQ.85.)GO TO 540
Y=0
IF(INVRT.EQ.0)Y=(X-Z)*2.
V(I)=Z+VX1+Y
GO TO 7361
540 V(I)=Z
7361 I=I+1
KN=KN+JC
IF(KN.NE.M)GO TO 940
INVRT=-1
RB=V(I-1)
ICT=-1
DO 8361 L=JD,72
JG=INP(L)
INP(L)=IBLA
IF(JG.EQ.KSLA)GO TO 9361
IF(JG.EQ.ISEMI)GO TO 2722
8361 IF(JG.EQ.ISTAR)ICT=0
9361 MLX=L+1
IF(ICT.LT.0)GO TO 17731
JZ=-1
2722 IF(ICT.LT.0)GO TO 7773
IAMP=-1
GO TO 3013
6361 CONTINUE
CALL EXIT
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361 IF(JF.NE.IAA)GO TO 4361
C FINDS 'ALL'.
IF(INP(JD+1).NE.IEL)GO TO 236
INP(JD)=IBLA
INP(JD+1)=IBLA
INP(JD+2)=IBLA
IALL=-1
GO TO 236
C TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
4361 IF(JF.NE.KSLA)GO TO 636
MLX=JD+1
JZ=-1
INP(JD)=ISEMI
436 IF(INP(MLX).NE.IBLA)GO TO 336
MLX=MLX+1
GO TO 436
636 IF(JF.NE.ISEMI)GO TO 936
336 IF(JMP.GT.4)GO TO 1899
GO TO (101,102,103,104),JMP
C INST PAR MOV LIST OTHERS
936 IF(JF.NE.IDOT)GO TO 736
IF(CODE.NE.-22.)GO TO 236
C DOT ONLY USED IN 'RHYTHM'.
L=INP(JD+1)
DO 836 KL=1,10
836 IF(L.EQ.IDAT(KL))GO TO 236
INP(JD)=1
GO TO 236
C CHANGES DOTTED RHYTHMS TO '1'S.
736 IF(JF.NE.ISTAR)GO TO 236
IAMP=-1
INP(JD)=ISEMI
236 CONTINUE
CALL EXIT
C IF ERROR - THEN EXIT.
102 NX=INP(ML)
IZ=ML
ML=ML+1
ISUB=13
IF(NX.EQ.IBLA)GO TO 102
JA=-1
IF(NX.EQ.IPP)GO TO 1899
IF(NX.EQ.IE)GO TO 2308
IF(NX.EQ.IR)GO TO 4337
IF(NX.EQ.ID)GO TO 7720
IF(NX.EQ.II)GO TO 1899
CALL EXIT
13 LPAR=VX1
IF(NX.NE.II)GO TO 136
INUM(LK)=LPAR
GO TO 1299
136 IAMP=0
IF(IALL.LT.0)ALL(LK,LPAR)=0
CVT=0
IF(LPAR.EQ.2)CVT=1.
IF(LPAR.GT.NP(LK).AND.LPAR.LT.31)NP(LK)=LPAR
IF(LPAR.EQ.32)LPAR=1
V(I)=LPAR+LK*10000
C +1=WDCNT, +2=CODE, +3='NM' CCCCC
IJ=I+1
I=I+4
ITMP=0
CODE=0
NFLG=1
ML=IZ+M
C M IS NUM. OF DIGITS IN PARAM NUM.
5702 ML=ML+1
IF(ML.GT.72)CALL EXIT
N=INP(ML)
IF(N.EQ.IBLA)GO TO 5702
NL=INP(ML+1)
JA=0
IF(N.EQ.IR)GO TO 6702
IF(N.EQ.IEN)GO TO 6005
IF(N.EQ.IEM.OR.N.EQ.ISS)GO TO 2007
IF(N.EQ.ID.AND.NL.EQ.IF)GO TO 7702
IF(N.EQ.ISEMI)GO TO 2018
IF(N.EQ.IPP)JA=-1
ISUB=1
GO TO 1899
C RE=REP R=RHY M=MOVE N=NOTES NU=NUM S=SUBR
6702 JA=-1
IF(NL.EQ.IE)GO TO 2703
CODE=-22.
CVT=1.
C P2 AND 'RHY' ALWAYS CONVERT AS 'DUR'.
GO TO 1016
6005 CODE=-33.
IF(NL.EQ.IU)GO TO 9702
CVT=-1.
GO TO 1016
9702 CODE=-44.
JA=-1
2007 NL=ML+2
DO 1007 KN=NL,72
JJ=INP(KN)
IF(JJ.EQ.IF)CVT=-1.
IF(JJ.EQ.ID)CVT=1.
1007 IF(JJ.EQ.ISEMI)GO TO 3007
3007 IF(N.EQ.ISS)GO TO 5007
IF(N.NE.IEM)GO TO 1016
4007 BW=V(IJ-2)
IC=0
DO 7031 K=ML+1,72
IF(INP(K).EQ.ISEMI)GO TO 8031
7031 IF(INP(K).EQ.IXX)IC=-1
8031 I=I-1
V(I)=0
X=-9900.-BY
IF(BY.EQ.0)X=-9900.-BG(LK)
IF(BW.EQ.X)GO TO 8005
IF(BW.NE.-9900.-BY)GO TO 1102
V(IJ-2)=X
GO TO 8005
1102 V(IJ)=V(IJ-1)
C IF BG>0, 'MOVE' POINTERS ARE NOT SET UP AT TIME 0.
V(IJ-1)=X
IJ=IJ+1
I=I+1
8005 LP=IJ-1
BW=-(X+9900.)
ISUB=2
JMP=3
IZ=-1
4703 GO TO 1299
103 IF(IZ.LT.0)GO TO 2102
BW=V(ICT)+BW
V(I)=-9900.-BW
V(I+1)=V(LP)
V(I+2)=JJ+3
V(I+3)=CODE
I=I+4
IZ=1
2102 IF(BW.GT.10000.)GO TO 6308
DO 5308 K=1,NWZ
5308 IF(BW.EQ.BNW(K))GO TO 6308
NWZ=NWZ+1
BNW(NWZ)=BW
6308 VX3=-9900.
VX2=VX3
GO TO 1899
2 IF(VX3.NE.-9900.)GO TO 3102
IF(VX2.NE.-9900.)GO TO 4102
VX2=VX1
VX1=10000.
4102 VX3=VX2
JJ=3
C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
3102 IF(IZ.GE.0)GO TO 3006
V(IJ)=JJ+3
CODE=-55.
IF(JJ.NE.3)CODE=-57.
IF(NFLG.LT.0)CODE=CODE-1.
IF(IC.LT.0)CODE=-59.
V(IJ+1)=CODE
C -10000. MEANS 'NOTES AT BG TIME 0'
C CODE=-56 OR -58 FOR NOTES.
IZ=0
3006 IF(NFLG.EQ.1)GO TO 5005
CVT=-1
IF(VX2.GT.VX3)VX2=VX2+.999
IF(VX3.GE.VX2)VX3=VX3+.999
IF(JJ.EQ.3)GO TO 5005
IF(VX4.GT.VX5)VX4=VX4+.999
IF(VX5.GE.VX4)VX5=VX5+.999
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
5005 ICT=I
IJ=IJ+1
DO 1006 K=1,JJ
1006 V(IJ+K)=VX(K)
I=I+JJ
V(I)=CVT
I=I+1
IJ=I+2
IF(IAMP.EQ.0)GO TO 1299
C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
V(I)=-9900.-BY
8703 I=I+1
GO TO 4773
5007 V(IJ)=3.
V(IJ+1)=-11.
V(I-1)=CVT
GO TO 4773
7702 CODE=-45
JA=-1
GO TO 1016
C ABOVE FOR DUTY FACTOR
1 I=I+JJ
ISUB=0
V(IJ+1)=NNUM
IF(NNUM.EQ.-2)CVT=-1.
IF(JJ.EQ.1)GO TO 4006
C IF IT IS '-2' THEN NOTES ARE PRINTED
IF(NNUM.NE.-2)GO TO 5006
IX=IJ+3
DO 2006 K=2,JJ,3
X=VX(K)
Y=VX(K+1)
IF(X.GT.Y)VX(K)=X+.999
2006 IF(Y.GE.X)VX(K+1)=Y+.999
5006 IX=IJ+2
DO 1001 K=1,JJ
1001 V(IX+K)=VX(K)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
GO TO 3013
4006 IF(JA)VX1=VX1/100.+9999.
C CHANGES /P5 P3/ TO /P5 9999.03/
V(I-1)=VX1
GO TO 3013
2703 ISUB=4
C 'REP'
VX1=0
VX2=0
VX3=0
ML=ML+1
GO TO 1899
4 V(IJ)=3.
V(IJ+1)=-66.0
IF(VX1.EQ.32.)VX1=1.
IF(VX1.EQ.0)VX1=LPAR
IF(VX2.EQ.0)VX2=LK-1
V(IJ+2)=VX1+VX2*10000.
KL=VX2
IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
IF(VX3.EQ.0.OR.LK.EQ.NINS)GO TO 4773
18 ML=LK+1
DO 1018 KL=ML,NINS
IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
V(I)=V(I-4)+10000.
V(I+1)=3.
V(I+2)=-66.
V(I+3)=V(I-1)
IF(DUR(KL).LT.0)DUR(KL)=DUR(LK)
1018 I=I+4
GO TO 4773
2018 V(IJ)=3.
V(IJ+1)=-66.
V(IJ+2)=NW+LK*10000
GO TO 4773
7720 V(I)=LK
V(I+1)=3.
V(I+2)=-67.
ML=ML+4
ISUB=14
GO TO 1899
14 V(I+3)=VX1
I=I+4
L=VX1
IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
GO TO 4773
C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
C ***** SCANNER *************************
2899 ML=ML+3
1899 IF(INP(ML).EQ.ISEMI.AND.ISUB.EQ.3)GO TO 1014
NNUM=-1
NL=0
ISKP=0
JJ=0
XMINUS=1.
999 IDECI=-1
IF(ISUB.EQ.6)XMINUS=1.
C ABOVE FOR READING MINUS AND PLUS NUMBS. IN GEN CARDS.
M=0
2799 N=INP(ML)
899 ML=ML+1
IF(N.EQ.ISEMI)GO TO 751
IF(N.NE.IBLA.AND.N.NE.ICOM)GO TO 510
4702 IF(ISKP)202,2799,2799
510 IF(JA.LT.0)GO TO 70
DO 77 K=1,12
IF(N.NE.ISCA(K))GO TO 77
IF(K.NE.2.AND.K.NE.4)GO TO 511
IF(ISUB.EQ.5)GO TO 511
NSWCH=K-4
GO TO 2799
C TO SWITCH ALWAYS USE OCT.# /PBF4/ /NE5/ P=PROXIMITY, N=NORMAL
511 NNUM=K
NFLG=-1
N=INP(ML)
IF(N.NE.IF)GO TO 6410
NNUM=NNUM-1
GO TO 7410
6410 IF(N.NE.ISS)GO TO 8410
NNUM=NNUM+1
7410 ML=ML+1
N=INP(ML)
GO TO 3410
8410 IF(N.NE.IU.AND.N.NE.IR)GO TO 3410
NNUM=-1
CVT=1.
IF(N.EQ.IR)CVT=-1.
GO TO 5551
3410 ML=ML+1
JJ=JJ+1
IF(ISUB.EQ.5)GO TO 1410
IF(N.NE.IEN)GO TO 371
VX(JJ)=86.
IF(DUR(LK))DUR(LK)=1000.
IAMP=-1
GO TO 5551
371 IF(N.EQ.ISEMI.OR.N.EQ.IBLA)GO TO 9410
DO 177 KN=2,8
IF(N.NE.IDAT(KN))GO TO 177
JSCA=KN-2
GO TO 2410
177 CONTINUE
GO TO 1411
9410 KN=-1
1411 IF(NSWCH.EQ.0)GO TO 2410
IF(KN)GO TO 2411
IF(N.EQ.IPLUS)NOLD=NOLD+6
IF(N.EQ.IMIN)NOLD=NOLD-6
C /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
2411 IF(NOLD-NNUM.GT.5.AND.JSCA.LT.7)JSCA=JSCA+1
IF(NOLD-NNUM.LT.-5.AND.JSCA.GT.0)JSCA=JSCA-1
C WILL JUMP TO NEAREST NOTE *********** MAY 22,71
2410 VX(JJ)=JSCA*12+NNUM
NOLD=NNUM
4410 NNUM=-2
IF(INP(ML).EQ.ISEMI)GO TO 5551
GO TO 310
C OCTAVE NUM WILL STICK UNTIL RESET
77 CONTINUE
C ABOVE FINDS SCALE NOTES
70 IF(N.NE.IMIN)GO TO 71
XMINUS=-1
GO TO 2799
210 JJ=JJ+1
IF(JJ.EQ.1)GO TO 3310
XMINUS=1.
VX(JJ)=0
C 'X N1,N2' MAY REPLACE 'REP N1,N2'. IF N2=0 THEN N2=2
GO TO 310
71 IF(N.EQ.IXX)GO TO 210
IF(N.EQ.IR)GO TO 73
1410 DO 78 K=1,11
IF(N.NE.IDAT(K))GO TO 78
ISKP=-1
IF(N.NE.IDOT)GO TO 79
IDECI=M
GO TO 75
79 M=M+1
IQ(M)=K-1
GO TO 75
78 CONTINUE
IF(N.EQ.KSLA)N=ISEMI
75 IF(ML.GT.73)CALL EXIT
CC WHY THE NEXT CHANGE? FOR DOTS MAYBE. IF(N.NE.ISEMI)GO TO 2799
IF(N.NE.ISEMI.AND.INP(ML).NE.1)GO TO 2799
751 IF(ISKP.EQ.0)GO TO 5551
202 IF(ISUB.EQ.5)GO TO 502
IF(IDECI.NE.-1)GO TO 302
IDECI=0
GO TO 402
302 IDECI=M-IDECI
402 NN=0
IEXP=M-1
IF(M.LT.1)M=1
DO 171 K=1,M
KN=10**IEXP
C BECAUSE '**0' DOES NOT WORK!!
IF(IEXP.EQ.0)KN=1
NN=NN+IQ(K)*KN
171 IEXP=IEXP-1
A=10**IDECI
C BECAUSE '**0' DOES NOT WORK!!
IF(IDECI.EQ.0)A=1.
JJ=JJ+1
VX(JJ)=NN/A*XMINUS
IF(ISUB.EQ.13)GO TO 13
1310 IF(INP(ML).NE.1)GO TO 310
C FOR DOTTED NOTES.
VX(JJ+1)=VX(JJ)*2.
JJ=JJ+1
ML=ML+1
GO TO 1310
206 ML=ML+2
3310 VX(JJ)=-99.
310 ISKP=0
IF(N.NE.ISEMI)GO TO 999
5551 GO TO(1,2,3,4,5,6,7,8,9,9,11,12,13,14,15),ISUB
502 JD=IQ(1)
IF(M.GT.1)JD=JD*10+IQ(2)
C NUMBERS UP TO 2 DIGITS ONLY
C PARAMETERS WILL PRINT +2 FOR PASS3. USE P2-30 ONLY. WILL PRINT P4-32.
C USE P33-35 FOR STORAGE IN UNIT GENS.
IF(NNUM.EQ.11)NNUM=100
IF(NNUM.EQ.6)NNUM=-(100+2*JD)
IF(NNUM.EQ.12)NNUM=-(2*JD)
C ABOVE IS TAKEN CARE OF AT 510+5
VX(JJ)=JD+NNUM
C IQ=OCTAVE N., NNUM=NOTE N.
NNUM=-1
GO TO 310
73 JJ=JJ+1
IF(INP(ML).EQ.IE)GO TO 206
C NEXT IS FOR A REST ('R')
VX(JJ)=85.
GO TO 4410
1106 KTMP=1
TP=60.
IAMP=0
BW=BY
ITMP=-1
JMP=5
ISUB=11
JA=-1
GO TO 2016
3019 V(I)=990000.00
V(I+1)=4.
V(I+2)=VX1
V(I+3)=VX2/TP
V(I+4)=VX3/TP
I=I+5
BY=BW
IF(VX1.EQ.0)GO TO 2308
BW=BW+VX1
V(I)=-9900.-BW
I=I+1
DO 3003 K=1,NWZ
3003 IF(BW.EQ.BNW(K))GO TO 9003
NWZ=NWZ+1
BNW(NWZ)=BW
9003 IF(IAMP)GO TO 4003
2016 VX3=0
VX2=0
GO TO 1299
11 IF(VX2.NE.0)GO TO 111
VX2=VX1
VX1=0
111 IF(VX3.EQ.0)VX3=VX2
IF(VX2.LT.11.)TP=1.
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=VX1
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX3
C PCH(1)=TIME (2)=MM1 (3)=MM2
KTMP=KTMP+1
IF(IAMP.EQ.0)GO TO 2016
4003 VX1=0
IAMP=0
VX2=VX3
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=0
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX2
C UP TO 30 ITMPO CHANGES MAY BE MADE.
1016 IA=I
IZ=1
3100 V(I-2)=CODE
ISUB=3
JMP=4
KZ=0
5016 IF(IAMP.GE.0)GO TO 1299
117 IF(IZ-2)3013,9004,9004
104 K=INP(ML)
IF(K.EQ.ITT)GO TO 1106
IF(K.EQ.ISEMI)GO TO 1014
IF(K.NE.IBLA) GO TO 1899
ML=ML+1
GO TO 104
3 IF(VX1.EQ.-99.)GO TO 4022
IF(CODE.LT.-22.)GO TO 17
2017 VX1=4./VX1
IF(JJ.NE.1)GO TO 2014
V(I)=VX1
GO TO 114
2014 DO 9006 L=2,JJ
IF(VX(L).EQ.0)GO TO 17
9006 VX1=4./VX(L)+VX1
JJ=1
17 V(I)=VX1
IF(JJ.EQ.1)GO TO 114
L=VX(JJ)-1
X=V(I)
NL=I+1
I=L+I
DO 1017 K=NL,I
1017 V(K)=X
C ADDS UP TOTAL OF NOTES IN SEQ.
IZ=IZ+L
GO TO 114
1014 V(I)=RB
114 RB=V(I)
I=I+1
IZ=IZ+1
GO TO 5016
4022 JC=VX2+.3
JD=VX3-.9
IF(JJ.EQ.2)JD=1
IZ=IZ+JC*JD
C JC=HOW MANY TIMES, JD=HOW MANY NOTES
DO 1005 K=1,JD
NL=I+JC-1
DO 2005 L=I,NL
2005 V(L)=V(L-JC)
1005 I=I+JC
RB=V(NL)
GO TO 5016
9004 IF(ITMP.EQ.0)GO TO 3013
KA=1
IC=1
K=0
Z=0
RC=0
9007 Y=PCH(3,IC)/TP
X=PCH(2,IC)/TP
Z=PCH(1,IC)
YY=2.*Z/(Y+X)
224 IF(YY.NE.0)YY=2.*(Z-X*YY)/YY**2
RAX=X
Z=PCH(1,IC)
XA=RA
RD=1
RB=0
ZZ=Z
7020 RA=V(IA+K)
4020 RD=1
IF(RA.LT.0)RD=-1.
RA=RA*RD
IF(KA.EQ.0)RA=RA-RC
W=RA
RB=W
IF(W.LE.Z)GO TO 2020
IF(Z.NE.0)GO TO 3020
RA=RA/Y
RB=-1.
RC=0
GO TO 8020
3020 W=Z
RC=W+RC
GO TO 24
2020 RC=0
24 IF(X.NE.Y)GO TO 424
RA=W/X
GO TO 8020
C DUR OF TMP + BG TIME OF TMP - NOTE VALUE - BG TIME OF NOTE
C CHN=TBG.
424 RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
RAX=RAX+YY*RA
8020 IF(KA.EQ.0)RA=RA+XA
KA=1
IF(RC.NE.0)GO TO 1011
V(IA+K)=RA*RD
IF(K.EQ.IZ)GO TO 3013
1011 K=K+1
IF(ZZ.NE.0)Z=Z-W
IF(Z.GT.0.OR.RB.EQ.-1.)GO TO 7020
IC=IC+1
IF(RB.EQ.W)GO TO 9007
KA=0
K=K-1
GO TO 9007
3013 V(I)=CVT
I=I+1
L=I-IJ
V(IJ+2)=L-4
V(IJ)=L
GO TO 4773
END
SUBROUTINE RUNIT
C******************************
DIMENSION VY(30),VZ(30),XT(10),IVG(8),PX1(10)
1,IPT(10,31)
COMMON /X/ P(30),J,L,CNT(10),BT,MK,VX(35),PL(30),DF,IXIN,NINS,TF,
1 ROFF(10),V(2000),NP(10),NCNT(10,32),INST(11),DUR(11),IALL,
1DURX,AMPFAC,BNW(40),IT(30),I,OP1,INUM(10),BG(80),INP(72),TP,
1NWZ,CVTX,ISCA(12),IDAT(11),IQ(25),SCAL(86),MU5(14)
1,LIST(78),ALL(10,31)
EQUIVALENCE (P1,P(1)),(P2,P(2)),(P3,P(3)),(VZ2,VZ(2)),(P4,P(4))
DATA IAMP/0/,IT3/0/,K/1/,P1/0/,T6/10000./,NW/1/,A/0/,
1NWX/0/,TDUR/0/,T2/1./,T4/1./,T5/0/,PR/0/,IVG/'GENA','GENB','GENC',
1'GEND','VARA','VARB','VARC','VARD'/,BLA/' '/,CHN/0/,RTF/.05/
J=1
MK=0
NWZZ=0
BG(NINS+1)=19999.
T6=10000.
DO 2118 K=1,NINS
M=NP(K)
IT(K)=0
IPT(K,31)=0
NCNT(K,31)=1
DO 2118 L=1,M
NCNT(K,L)=1
2118 IPT(K,L)=0
DO 5013 K=1,IXIN
5013 X=RAND(0.0,0.0)
IF(IALL.EQ.-1)GO TO 600
IL=NP(KZY)
X=DUR(KZY)
DO 6002 K=1,NINS
IF(DUR(K).LT.0)DUR(K)=X
6002 IF(NP(K).LT.IL)NP(K)=IL
C OUTPUT LOOP FROM HERE ON
600 IL=0
NWX=NWX+1
MK=MK+1
Y=BNW(NW)
723 IL=IL+1
3723 Z=V(IL)
IF(Z.EQ.-19899.)GO TO 732
IF(Z.NE.-9900.-Y)GO TO 723
2723 IL=IL+1
729 K=IL+2
C******** NEW 'ALL' ITEM GOES HERE. *******
RD=V(K)
IF(RD.EQ.-67.)GO TO 3726
LK=V(IL)/10000.+.2
IF(LK.GE.98)GO TO 7700
LP=V(IL)-LK*10000
C LK=INST # LP=PARAM #
LN=IPT(LK,LP)
IPT(LK,LP)=IL+2
IF(RD.EQ.-66.)GO TO 726
IF((RD.EQ.-55.).OR.(RD.EQ.-56.))GO TO 1726
2727 ML=IPT(LK,LP)
CC IF(IDALL.OR.LK.LT.KZY)GO TO 3727
IF(ALL(LK,LP))GO TO 3727
M=LK+1
C 'ALL' EFFECTS ONLY HIGHER INST. NUMBS.
DO 4727 KL=M,NINS
IF(NP(KL).LT.LP.AND.LP.LT.31)NP(KL)=LP
IPT(KL,LP)=ML
NCNT(KL,LP)=10000
IF(DUR(KL))DUR(KL)=1000.
C ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
4727 ALL(LK,LP)=-1.
C AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
GO TO 2150
3727 IF(V(IL).NE.V(LN-1).OR.LN.EQ.0)GO TO 727
DO 1727 L=1,NINS
DO 1727 KL=1,NP(L)
IF(LN.NE.IPT(L,KL))GO TO 1727
NCNT(L,KL)=10000
IPT(L,KL)=ML
C RESETS POINTERS FOR DUPL AND REP INSTS.
1727 CONTINUE
727 NCNT(LK,LP)=10000
2150 IF(K.LT.0)GO TO 4726
IL=IL+V(IL+1)+1.3
IF(V(IL).LT.0)GO TO 3723
GO TO 729
726 RB=V(IL+3)
K=RB/10000.
L=RB-K*10000
IPT(LK,LP)=IPT(K,L)
GO TO 2727
3726 LK=V(IL)
M=V(K+1)
K=-1
KL=NP(M)
DO 4726 L=1,KL
LP=L
IPT(LK,L)=IPT(M,L)
IF(IPT(M,L).NE.0)GO TO 2727
4726 CONTINUE
IPT(LK,31)=IPT(M,31)
K=0
GO TO 2150
C ABOVE IS FOR DUPLICATION ROUTINE
7700 T2=V(IL+4)
T1=V(IL+3)
TBG=Y
TDUR=V(IL+2)
AC=2.*TDUR/(T1+T2)
AC=2.*(TDUR-T1*AC)/AC**2
8700 IF(TDUR.EQ.0)TDUR=10000.
T5=1.
T6=TBG+TDUR
IT3=1.
IF(LK.EQ.98)IT3=IL+2
T4=1.
GO TO 2150
1726 IF(V(IL-1).GT.-10000.)GO TO 2727
RA=BT
K=IL-1
2726 V(K)=-9900.-RA
L=K+5
RB=V(L)+V(L-1)
V(L-1)=RA
K=K+V(K+2)+2
IF((V(K).GT.-10000.).OR.(V(K+1).NE.V(IL)).OR.
1 (V(K).NE.-9900.-RB))GO TO 2727
RA=RA+V(L)
DO 5726 L=1,NWZ
5726 IF(RA.EQ.BNW(L))GO TO 2726
NWZ=NWZ+1
BNW(NWZ)=RA
GO TO 2726
C CONVERTS BG TIME OF NOTE NUM TO REAL TIME. DOESN'T WORK WITH -66!!
C NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
732 IF(NWZ.LT.1)NWZ=1
DO 2602 K=NW,NWZ
2602 BNW(K)=BNW(K+1)
NWZ=NWZ-1
IF(NWZ.EQ.0)GO TO 2111
IF(NWZZ.EQ.1)GO TO 5111
NWZZ=1
IF(NWZ.EQ.1)GO TO 1111
DO 3111 K=1,NWZ
IF(BNW(K).LT.1000.)GO TO 3111
X=BNW(NWZZ)
BNW(NWZZ)=BNW(K)
BNW(K)=X
NWZZ=NWZZ+1
3111 CONTINUE
5111 IF(NWZZ.EQ.NWZ)GO TO 1111
L=NWZZ+1
X=BNW(NWZZ)
DO 4111 K=L,NWZ
IF(BNW(K).GT.X)GO TO 4111
RA=BNW(K)
BNW(K)=X
X=RA
4111 CONTINUE
BNW(NWZZ)=X
GO TO 1111
2111 NWZ=-1
C ABOVE ORDERS BNW DATA TO SAVE TIME AT 10 ON PG2.
1111 K=NWX-1
IF(NWX.NE.1)GO TO 1486
2 PRINT 111,I,IXIN,CVTX,TF
111 FORMAT(//' ***** SCORE *****',10X,
1'V ARRAY=',I4,'/2000 RANDOM NUMBER =',I6,4X,'SRATE=',F6.0,
14X,'TEMPO FACTOR=',F6.2/)
1486 IF((NWX.GT.1).AND.(IT(J).NE.-3))PRINT 3154,K,Y
IF(IT(J).EQ.-3)PRINT 5154,K,BX,INST(J)
DO 602 K=1,NINS
IF(DUR(K).LT.0)CALL EXIT
48 LK=INST(K)
IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 8826
IJ=IPT(K,31)
NCNT(K,31)=1
X=0
IF(IJ.NE.0)X=V(IJ+2)
RA=DUR(K)
IF(RA.GT.10000.)GO TO 83
PRINT 5396,LK,INUM(K),X,RA
GO TO 8826
5396 FORMAT(6XA4,'= INST NUM',I3,12X,
1'RANDOM TF =',F4.2,9X,'DURATION =',F6.2,'"')
7396 FORMAT(6XA4,'= INST NUM',I3,12X,
1'RANDOM TF =',F4.2,9X,'DURATION =',F5.0,'NOTES')
4396 FORMAT(12X'% RANDOM RESTS DUR=',F7.3,'", FROM',F6.3,' TO',F6.3)
485 FORMAT(35X'% RANDOM RESTS = ',F4.2)
83 RA=RA-10000.
PRINT 7396,LK,INUM(K),X,RA
8826 IF(NCNT(K,1).NE.10000)GO TO 602
IJ=IPT(K,1)
NCNT(K,1)=1
X=V(IJ+3)
IF(V(IJ).LT.6.)GO TO 7826
PRINT 4396,X,V(IJ+4),V(IJ+5)
GO TO 602
7826 PRINT 485,X
602 CONTINUE
715 IF(IT3.NE.1.)GO TO 1602
RA=T1*TP
RB=T2*TP
PRINT 6154,RA,RB,TDUR
IT3=0
1602 IF(NWX.EQ.1)GO TO 315
IF(IT(J).EQ.-3)GO TO 10
6154 FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
5154 FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,2XA4,' >>'/)
902 FORMAT(2XA4/)
3154 FORMAT(/' << BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
4154 FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)
IT(J)=IT(J)/10
GO TO 10
315 IF(OP1.NE.0)PRINT 4154,OP1
1601 IF(NWX.GT.1) GO TO 10
IF(TF.GT.10.)TF=TF/60.
TF=1000./TF
9926 DO 5015 K=1,NINS
IQ(K)=BG(K)*10000.
BG(K)=0
INP(K)=0
PX1(K)=0
5015 CNT(K)=0
BW=0
CVTX=511./CVTX
GO TO 500
10 M=0
JC=0
IF(NWZ.EQ.-1)GO TO 1740
DO 740 K=1,NWZZ
X=BNW(K)
IF(X.GT.BT.OR.X.LE.BW.OR.BW.LT.0)GO TO 2740
IT(J)=IT(J)*10
NW=K
GO TO 600
2740 IF((X.LT.1000.).OR.(X-J*10000.NE.CNT(J)+1))GO TO 740
X=BT+PR
NW=K
BX=CNT(J)+1.
IT(J)=-3
GO TO 600
740 CONTINUE
1740 IT(J)=0
31 KL=1
2031 CNT(J)=CNT(J)+1
ICT=CNT(J)
NPA=NP(J)
P1=PX1(J)
IF(BT.GE.DUR(J))GO TO 5174
IF(IQ(J).EQ.0)GO TO 200
P2=-IQ(J)/10000.
IQ(J)=0
CNT(J)=-1
ICT=-1
GO TO 4203
C MK IS FLAG FOR RESTS
200 MK=0
IF((BT.EQ.0.AND.J.EQ.1).OR.IPT(J,1).EQ.0)GO TO 203
KN=IPT(J,1)
IJ=V(KN)
IF(IJ.EQ.5)GO TO 1203
Z=(BT+9900.+V(KN-2))/V(KN+2)
IF(Z.GT.1.)Z=1.
Y=V(KN+3)
X=(V(KN+4)-Y)*Z+Y
IF(X.LE.0)IPT(J,1)=0
GO TO 204
1203 X=V(KN+3)
204 Y=RAND(0.0,1.0)
IF(Y-X.LT.0)MK=-1
203 DF=1.
C DUTY FACTOR ONLY SET IN SUBR.
DO 2155 L=2,NPA
IJ=IPT(J,L)
C******* NEW 'ALL' ITEM GOES HERE. *******
VX(L)=0
PM=1.
IF(IJ.GT.1)GO TO 2157
P(L)=0
GO TO 2155
2157 LN=IJ+2
NM=V(IJ-1)+LN-4
NL=V(IJ)
KN=NL/(-11)
IF(KN.EQ.0)GO TO 1100
GO TO (61,62,62,62,65,65),KN
1100 IF(V(IJ+1).EQ.1.)GO TO 1200
ML=3
1900 KA=1
VY(1)=0
DO 1156 K=LN,NM,ML
VY(KA+1)=V(K)+VY(KA)
1156 KA=KA+1
X=RAND(0.0,1.)
DO 1157 K=2,11
IF(X.GT.VY(K))GO TO 1157
KL=K-1
GO TO 1400
1157 CONTINUE
1400 LN=IJ+3*KL
RA=V(LN)
RB=V(LN+1)
PAR=RAND(RA,RB)
1300 IF(NL.EQ.-1)GO TO 1155
PM=2.
1061 ML=PAR
PAR=ML
GO TO 1155
1200 PAR=V(IJ+2)
GO TO 1300
61 X=P2
CALL SUBR
C SET CVT(IPAR) TO 1,0 OR -1 IN SUBR FOR DUR,--, OR FREQ.
IF(L.EQ.2)GO TO 4203
PM=PL(L)
CCC****** JUN 29,71
C****** JUN 29,71 IF(X.NE.P2)PR=P2
IF(X.EQ.P2)GO TO 2155
PR=P2
PP2=P2
GO TO 2155
C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
C TF,TEMPO WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR. IF P2 IS CHANGED BY OTHER
C CALLS ON SUBR. ALL TEMPO CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST BE SET TO 'REAL TIME'.)
62 KL=NCNT(J,L)+1
IF(KL.GT.V(IJ+1))KL=1
PAR=V(IJ+KL+1)
4157 NCNT(J,L)=KL
IF(NL.EQ.-45)DF=PAR
IF(KN.NE.3)GO TO 1155
IF(PAR.EQ.86.)GO TO 5174
PM=2.
IF(PAR.EQ.85.)MK=-1
GO TO 5155
65 W=-9900.-V(IJ-3)
C W=BG TIME OF MOVE.
X=V(IJ-1)
IF(NL.EQ.-56.OR.NL.EQ.-58)PM=2.
Z=(BT-W)/V(IJ+1)
C Z= % OF WAY THROUGH.
IF(Z.GT.1.)Z=1.
Y=V(LN)
W=V(IJ+3)
IF(X.EQ.8.)W=V(IJ+4)
IF(NL.LT.-58)GO TO 16002
PAR=(W-Y)*Z+Y
IF(X.EQ.8.)GO TO 1600
2600 IF(PM.EQ.1.)GO TO 1155
GO TO 1061
16002 PAR=(W-Y+1.)**Z-1.+Y
IF(W-Y)PAR=(Y-W+1.)**(1.-Z)-1.+W
IF(X.NE.8.)GO TO 2600
W=V(IJ+5)
Y=V(IJ+3)
X=(W-Y+1.)**Z-1.+Y
IF(W-Y)X=(Y-W+1.)**(1.-Z)-1.+W
GO TO 16003
C NEXT IS FOR MOVING RAND RANGES.
1600 W=V(IJ+3)
X=(V(IJ+5)-W)*Z+W
16003 PAR=RAND(PAR,X)
GO TO 2600
4155 K=(PAR-9999.0)*100.+.1
P(L)=P(K)
PM=PL(K)
VX(L)=VX(K)
GO TO 2155
C ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
1155 IF(PAR.GT.9999.)GO TO 4155
5155 P(L)=PAR
ML=V(IJ-1)-1.
VX(L)=V(ML+IPT(J,L))
IF(L.EQ.2)GO TO 4203
2155 PL(L)=PM
GO TO 1170
4203 PR=P2
RA=1.
RD=PR
IF(T5.EQ.0)GO TO 8203
IF((IT3.LE.1).OR.(BT.LT.TBG+TDUR))GO TO 6203
3155 IT3=IT3+3
TBG=TBG+TDUR
TDUR=V(IT3)
IF(BT.GE.TBG+TDUR)GO TO 3155
T1=V(IT3+1)
T2=V(IT3+2)
X=2.*TDUR/(T1+T2)
AC=2.*(TDUR-T1*X)/X**2
6203 RA=PR
IF(BT.EQ.TBG)XT(J)=T1
K=IT3
RC=0
RD=1.
KA=1
RB=0
Z=TDUR+TBG-BT
X=T1
Y=T2
YY=AC
CHN=TBG
ZZ=TDUR
GO TO 4020
8203 P2=RA*RD
7203 P2=P2*T4
X=P2*TF
K=X+.5
IF(X.LT.0)K=X-.5
CC****** JUN 29,71
72031 ROFF(J)=ROFF(J)+K-X
IF(ABS(ROFF(J)).LT.1.)GO TO 7155
Y=1.
IF(ROFF(J))Y=-1.
K=K-Y
ROFF(J)=ROFF(J)-Y
C ROUND-OFF GAP WILL NOT EXCEED .001
7155 PP2=K/1000.
IF(IPT(J,31).EQ.0)GO TO 6155
IF(ICT.EQ.-1)GO TO 1170
X=V(IPT(J,31)+3)
Y=RAND(1.-X,1.+X)
X=PP2
PP2=PP2*Y
IF(X-PP2+RTF)PP2=X+RTF
IF(PP2-X+RTF)PP2=X-RTF
C NEVER MORE THAN .1" DEVIATION WITH RAN TF. (RTF=.05 IN DATA.)
K=PP2*1000.+.5
PP2=K/1000.
6155 IF(ICT.GE.0)GO TO 2155
1170 IF(MK.LT.0.OR.PP2.LT.0)GO TO 2022
ZPAR=P1
PX1(J)=P1+PP2
C ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
L=INST(J)
IGENX=0
DO 4021 K=1,8
IF(L.NE.IVG(K))GO TO 4021
IGENX=K
GO TO 2170
4021 CONTINUE
INP(J)=P4
LK=0
DO 1021 K=1,NINS
1021 IF(PX1(K).GT.P1)LK=LK+INP(K)
IF(LK-IAMP-1.LT.0)GO TO 2170
IAMP=LK
AMPTIM=P1
2170 IF(P1.LT.OP1)GO TO 2612
P1=P1-OP1
C PUTS SPACES BETWEEN NOTES .GT. .05" APART
IF(A.GE.P1)GO TO 3170
PRINT 902
A=P1+.05
3170 X=INUM(J)
C INUM(J)=WHICH INST. DEFINITION BEING USED.
KL=0
NL=3
Y=1.
IF(IGENX.EQ.0)GO TO 4170
C IVG(K) HOLDS GEN AND VAR SPECIAL NAMES.
X=P3
IF(IGENX.LT.5)GO TO 3021
NL=2
Y=4
GO TO 7170
3021 Y=3.
C Y=3 FOR 'GENS'. Y=4 FOR 'VARS'.
DO 5170 K=6,30
IF(P3.EQ.2.)GO TO 5170
IF(P(K).EQ.511.)NPA=K
5170 VZ(K)=0
7170 DO 6170 K=2,30
ML=K+2
VX(K)=VX(ML)
IF(ML.GT.NPA)GO TO 5902
Z=P(ML)
IF(PL(ML).EQ.2)Z=30.868*2**(Z/12.)
GO TO 6170
5902 Z=0
6170 VZ(K)=Z
NPA=NPA-2
GO TO 8170
4170 IF(PL(3).EQ.2.)KL=P3+.5
DO 2021 K=3,30
IF(K.GT.NPA)GO TO 4902
Z=P(K)
IF(PL(K).EQ.2)Z=30.868*2**(Z/12.)
GO TO 2021
4902 Z=0
2021 VZ(K)=Z
VZ2=PP2*DF
C DUTY FACTOR CONVERSION
8170 IF(KL.GT.0)PRINT 2902,L,P1,X,VZ2,VZ(3),SCAL(KL),(VZ(K),K=4,
111),L,ICT,BT
IF(KL.EQ.0.)PRINT 9902,L,P1,X,(VZ(K),K=2,11),L,ICT,BT
C 'NOTES' MAY BE USED IN P3-30 BUT LETTER NAME WILL ONLY PRINT FOR P3!
IF(NPA.GT.11)PRINT 3902,(VZ(K),K=12,23),L,ICT,BT
C VX(K) HOLDS CONVERSION FLAG.
VY(2)=VZ2
DO 1902 K=NL,NPA
Z=VZ(K)
IF(VX(K).EQ.1.)Z=CVTX/Z
IF(VX(K).EQ.-1.)Z=CVTX*Z
1902 VY(K)=Z
NPA=NPA+1
VY(NPA)=CVTX/VZ2
C LAST PARAM NOW CONVERTED AS NOTE DUR. PASS3 WILL READ NEXT.
IF(Y.NE.1.)NPA=NPA-1
L=NPA+2
PRINT 3612,L,Y,P1,X,(VY(K),K=2,NPA)
WRITE (8)L,Y,P1,X,(VY(K),K=2,NPA)
C THIS IS WHAT PASS3 READS.
2612 P1=ZPAR
GO TO 21
3612 FORMAT(I3,F3.0,F7.2,F3.0,F7.2,30F9.3)
2902 FORMAT(1XA4,1XF7.2,F3.0,F7.2,F8.2,'(',A3,')',8F8.2,'< ',A4,' <',
1I3,F7.2)
9902 FORMAT(1XA4,1XF7.2,F3.0,F9.2,3X9F8.2,'< ',A4,' <',I3,F7.2)
3902 FORMAT(3X12F8.2,'< ',A4,' <',I3,F7.2)
C PRINTS RESTS
2022 PP2=ABS(PP2)
C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT PP2.
C FOR RESTS IN SEQS. TYPE -DUR.
C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
C RAN RESTS ARE NOT TOUCHED BY SUBROUTINES!!!
INP(J)=0
PX1(J)=P1+PP2
IF(P1.LT.OP1)GO TO 21
X=P1-OP1
IF(A.GE.X)GO TO 121
PRINT 902
A=X+.05
121 PRINT 104,INST(J),X,PP2,ICT
21 PR=ABS(PR)
BG(J)=BT+PR
IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
IF(BG(J).LT.DUR(J))GO TO 500
5174 BG(J)=19999.
DO 3174 K=1,NINS
C INSERTS CANT FOLLOW LAST REGULAR NOTE.(ADD REST IF INSERT AT END IS NEEDED.)
3174 IF(BG(K).LT.19999.)GO TO 500
GO TO 175
C CHOOSES INST WITH NEXT BEGIN TIME.
500 J=1
BW=BT
IF(NINS.EQ.1)GO TO 3022
5022 IF(BG(J).NE.19999.)GO TO 4022
J=J+1
GO TO 5022
4022 DO 22 K=2,NINS
22 IF((PX1(J).GT.PX1(K)).AND.(BG(K).NE.19999.))J=K
3022 BT=BG(J)
IF((BT.EQ.19999.).OR.(PX1(J).GE.DURX))GO TO 175
IF(CNT(J).GT.0)GO TO 1022
IF(CNT(J).EQ.0)PX1(J)=0
IF(CNT(J).EQ.-1)CNT(J)=0
C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
1022 IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 10
T4=T2
T5=0
T6=10000.
GO TO 10
175 Y=0
DO 105 K=1,NINS
X=PX1(K)-OP1
105 IF(Y.LT.X)Y=X
Y=Y+.5
C ADDS .5" OF SILENCE.
PRINT 7902, Y
L=2
Z=6.
PRINT 3612,L,Z,Y
WRITE (8)L,Z,Y
7902 FORMAT(' TER',F10.3,';'/)
603 FORMAT(I3,' INSTS. DURATIONS=',10F8.2)
TYPE 1603,AMPFAC,IAMP,AMPTIM
PRINT 1603,AMPFAC,IAMP,AMPTIM
DO 2175 K=1,NINS
2175 P(K)=PX1(K)-OP1
PRINT 603,NINS,(P(K),K=1,NINS)
TYPE 603,NINS,(P(K),K=1,NINS)
CALL EXIT
104 FORMAT(' ****',A4,2F9.3,7X,'REST <',I3)
1603 FORMAT(' AMPL. FACTOR=',F4.2,', MAX.AMP.=',I4,', AT TIME',
1 F8.3)
4020 RD=1
IF(RA.LT.0)RD=-1.
RA=RA*RD
IF(KA.EQ.0)RA=RA-RC
W=RA
RB=W
IF(W.LE.Z)GO TO 2020
IF(Z.NE.0)GO TO 3020
RA=RA/Y
RB=-1.
RC=0
GO TO 8020
3020 W=Z
RC=W+RC
GO TO 24
2020 RC=0
24 IF(X.NE.Y)GO TO 424
RA=W/X
GO TO 8020
C DUR OF TMP + BG TIME OF TMP - NOTE VALUE - BG TIME OF NOTE. CHN=TBG.
424 RAX=XT(J)
RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
XT(J)=RAX+YY*RA
8020 IF(KA.EQ.0)RA=RA+XA
KA=1
IF(RC.EQ.0)GO TO 8203
2011 XA=RA
IF(K.GT.1)GO TO 9920
K=I-6
ZPAR=-9900.-CHN-ZZ
DO 3011 KL=8,I
IF((V(K).EQ.ZPAR).AND.(V(K+1).EQ.990000.))GO TO 9920
3011 K=K-1
9920 W=ZZ
IF(V(K+3).LT.0)K=K+3
C ABOVE IS FOR TYPED IN ITMPO CHANGES
KA=K+3
ZZ=V(KA)
C DUR OF NEXT TEMPI
X=V(KA+1)
Y=V(KA+2)
213 KA=0
Z=ZZ
YY=2.*Z/(X+Y)
IF(YY.NE.0)YY=2.*(Z-X*YY)/YY**2
CHN=CHN+W
XT(J)=X
IF(KA.EQ.1)Z=0
RA=PR
KA=0
K=K+3
GO TO 4020
END
SUBROUTINE SUBR
COMMON/X/P(30),INST,IPAR,CNT(10),BT,IREST,CVT(35),PL(30),DF
C INST=INST N. IPAR=PARAM N. WHEN SUBROUTINE IS CALLED
C SET CVT(NPAR) TO -1.(FREQ), 0(AMPL.) OR 1.(DUR.) WHERE NPAR=PAR. TO BE CONVERTED
C IF NOTE NUMBERS ARE TO BE USED, SET PL(NPAR)=2.
C TO CREATE A REST IREST=-1. BT=BASIC TIME (P1 BEFORE TEMPO OR TF CHANGES.)
P(IPAR)=46.
IF(IPAR.EQ.10)RETURN
CVT(IPAR)=-1.
PL(IPAR)=2.
C P10=46. P11=440HZ
RETURN
END
INS 0 1; INSTRUMENT 1
OSC P6 P7 B2 F1;
OSC B2 P5 B2 F2/OUT B2 B1;
END ;
INS 0 2; INST 2
SET P5; P5 CAN CHANGE FUNC IN NEXT UNIT GENERATOR.
OSC P12 P4 B2 F12;
AD2 P7 B2 P11;
ENV P5 F1 B2 P9 P10 P11;
AD3 P7 B2 P8 B2;
MLT P7 B2 B3/RAN P6 B2 B4/RAH P7 B3 B2 ;
STR B2 B3 B2;
END ;
GEN 0 1 1 .5 0 .99 25;
-.5 128 0 256 1 511*; GEN INPUT MUST END WITH *
GEN 0 2 2 .3 .5 0 .4 4*; F2 , 3 HARMONICS (1,2,4)
GEN 0 3 3 1 -1*; F3 PUTS LINE FROM 1 TO -1 IN 511 STEPS
SCORE 35 .5 0 0 0 ;RAN NUM IS 35, TF=.5.
BUZZ 0 1 7; INST NAME, BG TIME=0, DUR=7 NOTES
P2 RHY/TEMPO/100 60 60*; SETS MM VALUE
4 ;QUARTER NOTE
8 16 X 2; 2 DOTTED 8THS
8 4; A DOTTED QUARTER
REP 2,2; LAST 2 DURATIONS PLAY TWICE
2 * ;HALF NOTE
;BLANKS OR COMMENTS MAY APPEAR WHERE INST NAMES EXPECTED
P6 ALL 10 DUR; 10 WILL BE IN P6 OF ALL INSTS.
P7 .33 A4,A .33 B3,B .34 C4,C ; FREQ??
P5 500 FREQ;
END ;
HISS 0 1 10/P5 REP 5 1/P2 NU DUR/1/2/3*;
I 1;
P3 NO;
C4/D/E/F/G;
A/B*;
P8 F1; THIS WILL CAUSE A NOTE TO PRINT
P7 NUMB;
1/2/3*;
END ;
ZAP 0 5;
DUPL 2;
P2 1 .1 .5 DUR;
P5 15 FREQ/END ;
RUN ;